home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / pkey12_1.zip / RW.LSP < prev    next >
Text File  |  1992-09-13  |  2KB  |  64 lines

  1. ;residential version of cw.lsp
  2. ;
  3. ;
  4. (setq oer *error* *error* err) 
  5. (pre)
  6. (if (= os1 nil)
  7. (setq os1 36)  )
  8. (setq dfop1 os1)
  9. (initget (+ 2 4))
  10. (setq os1(getdist(strcat "Enter window opening size <" (rtos os1) ">: ")))
  11. (if (= os1 nil)(setq os1 dfop1))
  12. (initget 1 "Left Right Center")
  13. (setq an1(getkword "Break from Left/Right/Center: "))
  14. (setq entity (entsel "\nPick break point: "))
  15. (if(= entity nil)(ref))
  16. (setq e1 (car entity))
  17. (setvar "aperture" 4)
  18. (setq p1 (car (cdr entity)))
  19. (setq p1 (osnap p1 "near"))
  20. (setq et1a(cdr (assoc 0 (entget e1))))
  21. (if (= et1a "POLYLINE")(PRINC "\n  ***** CAN NOT EDIT POLYLINE, TRY AGAIN *****"))
  22. (setq layername (cdr (assoc 8 (entget e1))))
  23. (setq sp (cdr (assoc 10 (entget e1))))
  24. (setq ep (cdr (assoc 11 (entget e1))))
  25. (setq temp1 (osnap p1 "mid"))
  26. (setq atemp (angle (osnap p1 "end") temp1))
  27. (setq temp1 (polar p1 atemp 8))  ;reset temp1
  28. (setvar "aperture" 60)
  29. (entdel e1)
  30. (setq temp2  (osnap temp1 "near"))
  31. (entdel e1)
  32. (setvar "aperture" 4)
  33. (setq up (/ pi 2))
  34. (setq dn (* pi 1.5))
  35. (setq a1 (angle sp ep))
  36. (cond((= an1 "Left")(if(and (> a1 up)(<= a1 dn))(setq a1 (- a1 pi))))
  37.      ((= an1 "Right")(if(or (<= a1 up)(> a1 dn))(setq a1 (+ a1 pi))))
  38.      ((= an1 "Center")(setq p1(polar p1 a1 (* (/ os1 2) -1.0)))))
  39. (setq a2 (angle temp1 temp2))
  40. (setq p2 (polar p1 a1 os1))
  41. (setq p3 (polar p1 a2 (distance temp1 temp2)))
  42. (setq p4 (polar p2 a2 (distance temp1 temp2)))
  43. (command "layer" "M" layername "")
  44. (command "break" e1 p1 p2)
  45. (command "break" p3 "f" p3 p4)
  46. (command "line" p2 p4 "")
  47. (command "line" p1 p3 "")
  48. (setq halfwidth (/ (distance p1 p3) 2.0))
  49. (setq p11 (polar p1 a2 -0.5))
  50. (setq p12 (polar p2 a2 -0.5))
  51. (setq p13 (polar p3 a2 1.0))
  52. (setq p14 (polar p4 a2 1.0))
  53. (setq p7 (polar p1 a2 halfwidth))
  54. (setq p8 (polar p2 a2 halfwidth))
  55. (setq p9 (polar p7 a2 1.0))
  56. (setq p10 (polar p8 a2 1.0))
  57. (command "layer" "M" "wd" "")
  58. (command "line" p1 p11 p12 p2 "")
  59. (command "line" p3 p13 p14 p4 "")
  60. (command "line" p7 p8 "")
  61. (command "line" p9 p10 "")
  62. (setq an1 nil os1 nil ent1 nil e1 nil p1 nil et1a nil lyrnm nil sp nil ep nil temp1 nil atemp nil up nil dn nil a1 nil a2 nil p2 nil p3 nil p4 nil p11 nil p12 nil p13 nil p14 nil p7 nil p8 nil p9 nil p10 nil)
  63. (post)
  64. (princ)